home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / risc_src.lha / risc_sources / comp / primops / mipsarith.t < prev    next >
Encoding:
Text File  |  1989-06-30  |  9.6 KB  |  269 lines
  1. (herald mipsarith
  2.   (env (*value orbit-env 'base-early-binding-env) primops))
  3.  
  4. ;;; Copyright (c) 1985 Yale University
  5. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  6. ;;; This material was developed by the T Project at the Yale University Computer 
  7. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  8. ;;; and to use it for any purpose is granted, subject to the following restric-
  9. ;;; tions and understandings.
  10. ;;; 1. Any copy made of this software must include this copyright notice in full.
  11. ;;; 2. Users of this software agree to make their best efforts (a) to return
  12. ;;;    to the T Project at Yale any improvements or extensions that they make,
  13. ;;;    so that these may be included in future releases; and (b) to inform
  14. ;;;    the T Project of noteworthy uses of this software.
  15. ;;; 3. All materials developed as a consequence of the use of this software
  16. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  17. ;;;    of acknowledging credit in academic research.
  18. ;;; 4. Yale has made no warrantee or representation that the operation of
  19. ;;;    this software will be error-free, and Yale is under no obligation to
  20. ;;;    provide any services, by way of maintenance, update, or otherwise.
  21. ;;; 5. In conjunction with products arising from the use of this material,
  22. ;;;    there shall be no use of the name of the Yale University nor of any
  23. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  24. ;;;    without prior written consent from Yale in each case.
  25. ;;;
  26.  
  27. ;;; Copyright (c) 1985 David Kranz
  28.  
  29. (define-constant fixnum-equal?
  30.   (primop fixnum-equal? ()
  31.     ((primop.generate self node)
  32.      (fixnum-comparator node jump-op/jn=))
  33.     ((primop.presimplify self node)
  34.      (presimplify-to-conditional node))
  35.     ((primop.make-closed self)
  36.      (make-closed-conditional self))
  37.     ((primop.conditional? self) t)
  38.     ((primop.conditional-type self node)
  39.      '#[type (proc #f (proc #f) (proc #f) top fixnum fixnum)])
  40.     ((primop.type self node)
  41.      '#[type (proc #f (proc #f boolean) fixnum fixnum)])))
  42.  
  43. (define-constant fixnum-less?
  44.   (primop fixnum-less? ()
  45.     ((primop.generate self node)
  46.      (fixnum-comparator node jump-op/j>=))
  47.     ((primop.presimplify self node)
  48.      (presimplify-to-conditional node))
  49.     ((primop.make-closed self)
  50.      (make-closed-conditional self))
  51.     ((primop.conditional? self) t)
  52.     ((primop.conditional-type self node)
  53.      '#[type (proc #f (proc #f) (proc #f) top fixnum fixnum)])
  54.     ((primop.type self node)
  55.      '#[type (proc #f (proc #f boolean) fixnum fixnum)])))
  56.  
  57. (define-constant char=
  58.   (primop char= ()
  59.     ((primop.generate self node)
  60.      (character-comparator node jump-op/jn=))
  61.     ((primop.presimplify self node)
  62.      (presimplify-to-conditional node))
  63.     ((primop.conditional? self) t)
  64.     ((primop.make-closed self)
  65.      (make-closed-conditional self))
  66.     ((primop.conditional-type self node)
  67.      '#[type (proc #f (proc #f) (proc #f) top char char)])
  68.     ((primop.type self node)
  69.      '#[type (proc #f (proc #f boolean) char char)])))
  70.  
  71. (define-constant char<
  72.   (primop char< ()
  73.     ((primop.generate self node)
  74.      (character-comparator node jump-op/j>=))
  75.     ((primop.presimplify self node)
  76.      (presimplify-to-conditional node))
  77.     ((primop.make-closed self)
  78.      (make-closed-conditional self))
  79.     ((primop.conditional? self) t)
  80.     ((primop.conditional-type self node)
  81.      '#[type (proc #f (proc #f) (proc #f) top char char)])
  82.     ((primop.type self node)
  83.      '#[type (proc #f (proc #f boolean) char char)])))
  84.  
  85. (define-constant char->ascii
  86.   (primop char->ascii ()
  87.     ((primop.generate self node)
  88.      (generate-char->ascii node))
  89.     ((primop.rep-wants self)
  90.      '(rep/char))
  91.     ((primop.arg-specs self)
  92.      '(scratch))
  93.     ((primop.type self node)
  94.      '#[type (proc #f (proc #f fixnum) char)])))
  95.  
  96. (define-constant ascii->char
  97.   (primop ascii->char ()
  98.     ((primop.generate self node)
  99.      (generate-ascii->char node))
  100.     ((primop.rep-wants self)
  101.      '(rep/integer))
  102.     ((primop.arg-specs self)
  103.      '(scratch))
  104.     ((primop.type self node)
  105.      '#[type (proc #f (proc #f char) fixnum)])))
  106.  
  107. ;;; ARITHMETIC
  108. ;;;===========================================================================
  109.  
  110. (define-constant fixnum-add
  111.   (primop fixnum-add ()
  112.     ((primop.generate self node)
  113.      (generate-numeric-op node 'add))
  114.     ((primop.simplify self node)
  115.      (simplify-fixnum-add node))
  116.     ((primop.type self node)
  117.      '#[type (proc #f (proc #f fixnum) fixnum fixnum)])))
  118.  
  119. (define-constant fixnum-subtract
  120.   (primop fixnum-subtract ()
  121.     ((primop.generate self node)
  122.      (generate-numeric-op node 'sub))
  123.     ((primop.simplify self node)
  124.      (simplify-fixnum-subtract node))
  125.     ((primop.type self node)
  126.      '#[type (proc #f (proc #f fixnum) fixnum fixnum)])))
  127.  
  128. (define-constant fixnum-multiply
  129.   (primop fixnum-multiply ()
  130.     ((primop.generate self node)
  131.      (generate-numeric-op node 'mul))
  132.     ((primop.simplify self node)
  133.      (simplify-fixnum-multiply node))
  134.     ((primop.type self node)
  135.      '#[type (proc #f (proc #f fixnum) fixnum fixnum)])))
  136.  
  137. (define-constant fixnum-divide
  138.   (primop fixnum-divide ()
  139.     ((primop.generate self node)
  140.      (generate-numeric-op node 'div))
  141.     ((primop.simplify self node)
  142.      (simplify-fixnum-divide node))
  143.     ((primop.type self node)
  144.      '#[type (proc #f (proc #f fixnum) fixnum fixnum)])))
  145.  
  146. (define-constant fixnum-remainder
  147.   (primop fixnum-remainder ()
  148.     ((primop.generate self node)
  149.      (generate-numeric-op node 'rem))
  150.     ((primop.type self node)
  151.      '#[type (proc #f (proc #f fixnum) fixnum fixnum)])))
  152.  
  153. (define-constant fixnum-logior
  154.   (primop fixnum-logior ()
  155.     ((primop.generate self node)
  156.      (generate-numeric-op node 'or))
  157.     ((primop.simplify self node)
  158.      (simplify-fixnum-logior node))
  159.     ((primop.type self node)
  160.      '#[type (proc #f (proc #f fixnum) fixnum fixnum)])))
  161.  
  162. (define-constant fixnum-logxor
  163.   (primop fixnum-logxor ()
  164.     ((primop.generate self node)
  165.      (generate-numeric-op node 'xor))
  166.     ((primop.simplify self node)
  167.      (simplify-fixnum-logxor node))
  168.     ((primop.type self node)
  169.      '#[type (proc #f (proc #f fixnum) fixnum fixnum)])))
  170.  
  171. (define-constant fixnum-logand
  172.   (primop fixnum-logand ()
  173.     ((primop.generate self node)
  174.      (generate-numeric-op node 'and))
  175.     ((primop.simplify self node)
  176.      (simplify-fixnum-logand node))
  177.     ((primop.type self node)
  178.      '#[type (proc #f (proc #f fixnum) fixnum fixnum)])))
  179.  
  180. (define-constant (fixnum-lognot x)
  181.    (fixnum-logxor x -1))                                      
  182.  
  183. (define-constant (fixnum-negate x)
  184.   (fixnum-subtract 0 x))
  185.  
  186.  
  187.  
  188. (define-constant (fixnum-ash integer amount)
  189.   (if (fixnum-less? amount 0) 
  190.       (fixnum-ashr integer (fixnum-subtract 0 amount))
  191.       (fixnum-ashl integer amount)))
  192.                                     
  193. (define-constant fixnum-ashl
  194.  (primop fixnum-ashl ()
  195.     ((primop.generate self node)
  196.      (generate-numeric-op node 'ashl))
  197.     ((primop.simplify self node)
  198.      (simplify-fixnum-shift node fixnum-ashl))
  199.     ((primop.type self node)
  200.      '#[type (proc #f (proc #f fixnum) fixnum fixnum)])))
  201.                                     
  202. (define-constant fixnum-ashr
  203.  (primop fixnum-ashr ()
  204.     ((primop.generate self node)
  205.      (generate-numeric-op node 'ashr))
  206.     ((primop.simplify self node)
  207.      (simplify-fixnum-shift node fixnum-ashr))
  208.     ((primop.type self node)
  209.      '#[type (proc #f (proc #f fixnum) fixnum fixnum)])))
  210.  
  211. (define-constant fixnum-add-with-overflow
  212.   (primop fixnum-add-with-overflow ()
  213.     ((primop.values-returned self) 1)                               
  214.     ((primop.generate self node)
  215.      (generate-op-with-overflow node 'add))
  216.     ((primop.presimplify self node)
  217.      (presimplify-to-funny-conditional node 1))
  218.     ((primop.conditional? self) t)
  219.     ((primop.make-closed self) primop/undefined-effect)
  220.     ((primop.conditional-type self node)
  221.      '#[type (proc #f (proc #f fixnum) (proc #f fixnum) top fixnum fixnum)])
  222.     ((primop.type self node)
  223.      '#[type (proc #f (proc #f boolean fixnum) fixnum fixnum)])))
  224.  
  225. (define-constant fixnum-subtract-with-overflow
  226.   (primop fixnum-subtract-with-overflow ()
  227.     ((primop.values-returned self) 1)                               
  228.     ((primop.generate self node)
  229.      (generate-op-with-overflow node 'subtract))
  230.     ((primop.presimplify self node)
  231.      (presimplify-to-funny-conditional node 1))
  232.     ((primop.conditional? self) t)
  233.     ((primop.make-closed self) primop/undefined-effect)
  234.     ((primop.conditional-type self node)
  235.      '#[type (proc #f (proc #f fixnum) (proc #f fixnum) top fixnum fixnum)])
  236.     ((primop.type self node)
  237.      '#[type (proc #f (proc #f boolean fixnum) fixnum fixnum)])))
  238.  
  239. (define-constant fixnum-multiply-with-overflow
  240.   (primop fixnum-multply-with-overflow ()
  241.     ((primop.values-returned self) 1)                               
  242.     ((primop.generate self node)
  243.      (generate-op-with-overflow node 'multiply))
  244.     ((primop.presimplify self node)
  245.      (presimplify-to-funny-conditional node 1))
  246.     ((primop.conditional? self) t)
  247.     ((primop.make-closed self) primop/undefined-effect)
  248.     ((primop.conditional-type self node)
  249.      '#[type (proc #f (proc #f fixnum) (proc #f fixnum) top fixnum fixnum)])
  250.     ((primop.type self node)
  251.      '#[type (proc #f (proc #f boolean fixnum) fixnum fixnum)])))
  252.       
  253. (define-constant two-fixnums?
  254.   (primop two-fixnums? ()
  255.     ((primop.generate self node)
  256.      (generate-two-fixnums node))
  257.     ((primop.presimplify self node)
  258.      (presimplify-to-conditional node))
  259.     ((primop.make-closed self) primop/undefined-effect)
  260.     ((primop.conditional? self) t)
  261.     ((primop.conditional-type self node)
  262.      '#[type (proc #f (proc #f) (proc #f) top top top)])
  263.     ((primop.type self node)
  264.      '#[type (proc #f (proc #f boolean) top top)])))
  265.  
  266.  
  267.  
  268.  
  269.